home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / Duck Report / _SETUP.1 / DQSelectV.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-18  |  4.9 KB  |  205 lines

  1. unit DQSelectV;
  2. {$I DQuery.inc}
  3.  
  4. interface
  5.  
  6. uses
  7.     {$IFDEF WIN32}
  8.         Windows, ComCtrls,
  9.     {$ELSE}
  10.         WinTypes, WinProcs,
  11.     {$ENDIF}
  12.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13.   StdCtrls, Buttons, Db, DBTables;
  14.  
  15. type
  16.   TFormDQSelectValue = class(TForm)
  17.     LBValue: TListBox;
  18.     LValue: TLabel;
  19.     BBOK: TBitBtn;
  20.     BBCancel: TBitBtn;
  21.     BBHelp: TBitBtn;
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure FormDestroy(Sender: TObject);
  24.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  25.     procedure BBOKClick(Sender: TObject);
  26.     procedure BBCancelClick(Sender: TObject);
  27.     procedure BBHelpClick(Sender: TObject);
  28.   private
  29.         Query:        TQuery;
  30.      StFieldName:String;
  31.   public
  32.       bString:                Boolean;
  33.      StValue:                String;
  34.      Procedure    GetFieldValueString (StDB, StTable,
  35.                         StAlias, StField: String; TempSession:    TSession);
  36.   end;
  37.  
  38. var
  39.   FormDQSelectValue: TFormDQSelectValue;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. Procedure TFormDQSelectValue.FormCreate(Sender: TObject);
  46. Begin
  47.     Query    := nil;
  48.   bString    := FALSE;
  49. End;
  50. Procedure TFormDQSelectValue.FormDestroy(Sender: TObject);
  51. Begin
  52.     if Query <> nil Then
  53.       Query.Free;
  54.     FormDQSelectValue    := nil;
  55. End;
  56. Procedure TFormDQSelectValue.FormClose(Sender: TObject;
  57.   var Action: TCloseAction);
  58. Begin
  59.     Action    := caFree;
  60. End;
  61. Procedure TFormDQSelectValue.BBOKClick(Sender: TObject);
  62. Var
  63.     ItemIndex:    Integer;
  64.   Field:        TField;
  65.   i:                Integer;
  66.   St:            String;
  67. Begin
  68.     ItemIndex    := LBValue.ItemIndex;
  69.   StValue        := '';
  70.   Field            := Query.FieldByName(StFieldName);
  71.   if ItemIndex >= 0 Then
  72.   Begin
  73.       if LBValue.MultiSelect Then
  74.      Begin
  75.          For i := 0 To LBValue.Items.Count - 1 Do
  76.          Begin
  77.             if not LBValue.Selected[i] Then Continue;
  78.              St                := LBValue.Items[i];
  79.             if StValue <> '' Then
  80.                 StValue    := StValue + ' , ';
  81.            Case Field.DataType of
  82.               ftSmallint,
  83.               ftInteger,
  84.               ftWord,
  85.               ftBoolean,
  86.               ftFloat,
  87.               ftCurrency,
  88.               ftBCD,
  89.               ftBytes,
  90.               ftAutoInc:
  91.                   StValue    := StValue + St;
  92.            Else
  93.                StValue    := StValue + '''' + St + ''''
  94.            End;
  95.          End;
  96.      End
  97.      Else
  98.      Begin
  99.             StValue        := LBValue.Items.Strings[ItemIndex];
  100.         Case Field.DataType of
  101.             ftSmallint,
  102.            ftInteger,
  103.            ftWord,
  104.            ftBoolean,
  105.            ftFloat,
  106.            ftCurrency,
  107.            ftBCD,
  108.            ftBytes,
  109.            ftAutoInc:
  110.                Begin
  111.            End;
  112.            Else
  113.                StValue    := '''' + StValue + '''';
  114.            End;
  115.      End;
  116.   End;
  117.     Close;
  118.   ModalResult    := mrOK;
  119. End;
  120. Procedure TFormDQSelectValue.BBCancelClick(Sender: TObject);
  121. Begin
  122.     StValue        := '';
  123.     Close;
  124.   ModalResult    := mrCancel;
  125. End;
  126. Procedure TFormDQSelectValue.BBHelpClick(Sender: TObject);
  127. Begin
  128.     Beep;
  129. End;
  130. Procedure TFormDQSelectValue.GetFieldValueString (StDB, StTable,
  131.         StAlias, StField: String; TempSession:    TSession);
  132. Var
  133.     Cursor:    TCursor;
  134.   Field:    TField;
  135.   FieldDT:    TDateTimeField;
  136.   St:        String;
  137. Begin
  138.     if TempSession = nil Then
  139.       TempSession    := Session;
  140.     LValue.Caption    := 'Select value';
  141.     StFieldName        := StField;
  142.     Query                := TQuery.Create (Self);
  143.     Query.SessionName    := TempSession.SessionName;
  144.     Query.SQL.Add('SELECT DISTINCT');
  145.   Query.SQL.Add (Char(#09) + StField);
  146.   
  147.   {$IFDEF VERIFY_MSACCESS}
  148.   St    := TempSession.GetAliasDriverName (StDB);
  149.   if St = 'MSACCESS' Then
  150.   Begin
  151.       Query.DatabaseName    := StDB;
  152.      Query.SQL.Add ('FROM [' + StTable + ']' + StAlias); 
  153.   End
  154.   Else 
  155.   {$ENDIF}
  156.       Query.SQL.Add ('FROM '':' + StDB + ':' + StTable + '''' + ' ' + StAlias);
  157.  
  158.   Cursor            := Screen.Cursor;
  159.     Screen.Cursor    := crHourGlass;
  160.   Try
  161.       Query.Active    := TRUE;
  162.       Query.First;
  163.      Field    := Query.Fields[0]; 
  164.       LBValue.Items.BeginUpdate;
  165.       Try
  166.          Case Field.DataType of
  167.             ftDate:
  168.                 Begin
  169.                    FieldDT    := TDateTimeField (Field);
  170.                   FieldDT.DisplayFormat    := 'MM/DD/YYYY';
  171.                End;
  172.             ftTime:
  173.                Begin
  174.                   FieldDT    := TDateTimeField (Field);
  175.                   FieldDT.DisplayFormat    := 'hh:mm:ss AM/PM';
  176.                End;
  177.             ftDateTime:
  178.                 Begin
  179.                   FieldDT    := TDateTimeField (Field);
  180.                   FieldDT.DisplayFormat    := 'MM/DD/YYYY hh:mm:ss AM/PM';
  181.                End;
  182.         Else
  183.             FieldDT    := nil;
  184.             End;
  185.             While not Query.EOF Do
  186.         Begin
  187.             if FieldDT <> nil Then
  188.            Begin
  189.                LBValue.Items.Add (FormatDateTime (FieldDT.DisplayFormat, FieldDT.AsDateTime));
  190.            End
  191.            Else
  192.                LBValue.Items.Add (Field.AsString);
  193.            if LBValue.Items.Count >= 300 Then Break;
  194.               Query.Next;
  195.           End;
  196.      Finally
  197.           LBValue.Items.EndUpdate;
  198.       End;
  199.   Finally
  200.       Screen.Cursor := Cursor;
  201.   End;
  202. End;
  203.  
  204. End.
  205.